home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 13 / CU Amiga Magazine's Super CD-ROM 13 (1997)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1997-08].iso / CUCD / Graphics / Ghostscript / data / gs_setpd.ps < prev    next >
Text File  |  1997-04-12  |  20KB  |  629 lines
  1. %    Copyright (C) 1994, 1996 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of Aladdin Ghostscript.
  4. % 
  5. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  6. % or distributor accepts any responsibility for the consequences of using it,
  7. % or for whether it serves any particular purpose or works at all, unless he
  8. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  9. % License (the "License") for full details.
  10. % 
  11. % Every copy of Aladdin Ghostscript must include a copy of the License,
  12. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  13. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  14. % under certain conditions described in the License.  Among other things, the
  15. % License requires that the copyright notice and this notice be preserved on
  16. % all copies.
  17.  
  18. % The current implementation of setpagedevice has the following limitations:
  19. %    - It doesn't attempt to "interact with the user" for Policy = 2.
  20.  
  21. languagelevel 1 .setlanguagelevel
  22. level2dict begin
  23.  
  24. % ---------------- Redefinitions ---------------- %
  25.  
  26. % Redefine .beginpage and .endpage so that they call BeginPage and
  27. % EndPage respectively if appropriate.
  28.  
  29. /.beginpage
  30.  { .currentshowpagecount
  31.     { .currentpagedevice pop /BeginPage .knownget { exec } { pop } ifelse }
  32.    if
  33.  } bind odef
  34.  
  35. /.endpage
  36.  { .currentshowpagecount
  37.     { exch .currentpagedevice pop /EndPage .knownget
  38.        { exec }
  39.        { exch pop 2 ne }
  40.       ifelse
  41.     }
  42.     { 2 ne
  43.     }
  44.    ifelse
  45.  } bind odef
  46.  
  47. % Define interpreter callouts for handling gstate-saving operators,
  48. % to make sure that they create a page device dictionary for use by
  49. % the corresponding gstate-restoring operator.
  50. % We'd really like to avoid the cost of doing this, but we don't see how.
  51. % The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
  52. % %copygstatepagedevice, and %currentgstatepagedevice are known to the
  53. % interpreter.
  54.  
  55. (%gsavepagedevice) cvn
  56.  { currentpagedevice pop gsave
  57.  } bind def
  58.  
  59. (%savepagedevice) cvn
  60.  { currentpagedevice pop save
  61.  } bind def
  62.  
  63. (%gstatepagedevice) cvn
  64.  { currentpagedevice pop gstate
  65.  } bind def
  66.  
  67. (%copygstatepagedevice) cvn
  68.  { currentpagedevice pop copy
  69.  } bind def
  70.  
  71. (%currentgstatepagedevice) cvn
  72.  { currentpagedevice pop currentgstate
  73.  } bind def
  74.  
  75. % Define interpreter callouts for handling gstate-restoring operators
  76. % when the current page device needs to be changed.
  77. % The names %grestorepagedevice, %grestoreallpagedevice,
  78. % %restorepagedevice, and %setgstatepagedevice are known to the interpreter.
  79.  
  80. /.installpagedevice
  81.  {    % Since setpagedevice doesn't create new device objects,
  82.     % we must (carefully) reinstall the old parameters in
  83.     % the same device.
  84.    .currentpagedevice pop null currentdevice null .trysetparams
  85.    dup type /booleantype eq
  86.     { pop pop }
  87.     {        % This should never happen!
  88.       DEBUG { (Error in .trysetparams!\n) print pstack flush } if
  89.       cleartomark pop pop pop
  90.       /.installpagedevice cvx /rangecheck signalerror
  91.     }
  92.    ifelse pop pop
  93.    erasepage initgraphics .beginpage
  94.  } bind def
  95.  
  96. /.uninstallpagedevice
  97.  { 2 .endpage { .currentnumcopies false .outputpage } if
  98.    nulldevice
  99.  } bind def
  100.  
  101. (%grestorepagedevice) cvn
  102.  { .uninstallpagedevice grestore .installpagedevice
  103.  } bind def
  104.  
  105. (%grestoreallpagedevice) cvn
  106.  { .uninstallpagedevice grestore .installpagedevice grestoreall
  107.  } bind def
  108.  
  109. (%restorepagedevice) cvn
  110.  { .uninstallpagedevice grestore .installpagedevice restore
  111.  } bind def
  112.  
  113. (%setgstatepagedevice) cvn
  114.  { .uninstallpagedevice setgstate .installpagedevice
  115.  } bind def
  116.  
  117. % Redefine .currentnumcopies so it consults the NumCopies device parameter.
  118. /.numcopiesdict mark
  119.   /NumCopies dup
  120. .dicttomark readonly def
  121.  
  122. /.currentnumcopies
  123.  { currentdevice //.numcopiesdict .getdeviceparams
  124.    dup type /integertype eq
  125.     { exch pop exch pop }
  126.     { cleartomark #copies }
  127.    ifelse
  128.  } bind odef
  129.  
  130. % ---------------- Auxiliary definitions ---------------- %
  131.  
  132. % Define the required attributes of all page devices, and their default values.
  133. % We don't include attributes such as .MediaSize, which all devices
  134. % are guaranteed to supply on their own.
  135. /.defaultpolicies mark
  136.   /PolicyNotFound 1
  137.   /PageSize 0
  138.   /PolicyReport {pop} bind
  139. .dicttomark readonly def
  140. /.requiredattrs mark
  141.   /PageOffset [0 0] readonly
  142. % We define InputAttributes and OutputAttributes with a single
  143. % dummy media type that handles pages of any size.
  144. % Devices that care will override this.
  145.   /InputAttributes mark 0
  146.     mark /PageSize [0 dup 16#7ffff dup] .dicttomark readonly
  147.   .dicttomark readonly
  148.   (%MediaSource) 0
  149.   /OutputAttributes mark 0
  150.     mark .dicttomark readonly
  151.   .dicttomark readonly
  152.   (%MediaDestination) 0
  153.   /Install {.callinstall} bind
  154.   /BeginPage {.callbeginpage} bind
  155.   /EndPage {.callendpage} bind
  156.   /Policies .defaultpolicies
  157. .dicttomark readonly def
  158.  
  159. % Define currentpagedevice so it creates the dictionary on demand if needed,
  160. % adding all the required entries defined just above.
  161. % We have to deal specially with entries that the driver may change
  162. % on its own.
  163. /.dynamicppkeys mark
  164.   /.MediaSize dup        % because it changes when PageSize is set
  165.   /PageCount dup
  166. .dicttomark readonly def
  167. /.makecurrentpagedevice        % - .makecurrentpagedevice <dict>
  168.  { currentdevice null .getdeviceparams
  169.     % In case of duplicate keys, .dicttomark takes the entry
  170.     % lower on the stack, so we can just append the defaults here.
  171.    .requiredattrs { } forall .dicttomark
  172.    dup .setpagedevice
  173.  } bind def
  174. /currentpagedevice
  175.  { .currentpagedevice
  176.     { dup length 0 eq
  177.        { pop .makecurrentpagedevice
  178.        }
  179.        {    % If any of the dynamic keys have changed,
  180.         % we must update the page device dictionary.
  181.      currentdevice //.dynamicppkeys .getdeviceparams .dicttomark
  182.       {    % Stack: current key value
  183.         2 index 2 index .knownget { 1 index ne } { true } ifelse
  184.          { 2 index wcheck not
  185.         {    % This is the first entry being updated.
  186.             % Copy the dictionary to make it writable.
  187.           3 -1 roll dup length dict .copydict
  188.           3 1 roll
  189.         }
  190.            if
  191.            2 index 3 1 roll put
  192.          }
  193.          { pop pop
  194.          }
  195.         ifelse
  196.       }
  197.      forall
  198.         % We would like to do a .setpagedevice so we don't keep
  199.         % re-creating the dictionary.  Unfortunately, the effect
  200.         % of this is that if any dynamic key changes (PageCount
  201.         % in particular), we will do the equivalent of a
  202.         % setpagedevice at the next restore or grestore.
  203.         % Therefore, we make the dictionary read-only, but
  204.         % we don't store it away.  I.e., NOT:
  205.         % dup wcheck { .setpagedevice .currentpagedevice pop } if
  206.      readonly
  207.        }
  208.       ifelse
  209.     }
  210.    if
  211.  } bind odef
  212.  
  213. % The implementation of setpagedevice is quite complex.  Currently,
  214. % everything but the media matching algorithm is implemented here.
  215.  
  216. % By default, we only present the requested changes to the device,
  217. % but there are some parameters that require special merging action.
  218. % Define those parameters here, with the procedures that do the merging.
  219. % The procedures are called as follows:
  220. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  221. /.mergespecial mark
  222.   /InputAttributes
  223.    { dup null eq
  224.       { pop null
  225.       }
  226.       { 3 copy pop .knownget
  227.      { dup null eq
  228.         { pop dup length dict }
  229.         { dup length 2 index length add dict .copydict }
  230.        ifelse
  231.      }
  232.      { dup length dict
  233.      }
  234.         ifelse .copydict readonly
  235.       }
  236.      ifelse
  237.    } bind
  238.   /OutputAttributes 1 index
  239.   /Policies
  240.     { 3 copy pop .knownget
  241.        { dup length 2 index length add dict .copydict }
  242.        { dup length dict }
  243.       ifelse copy readonly
  244.     } bind
  245. .dicttomark readonly def
  246.  
  247. % Define the keys used in input attribute matching.
  248. /.inputattrkeys [
  249.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  250. ] readonly def
  251. % Define other keys used in media selection.
  252. /.inputselectionkeys [
  253.   /MediaPosition /Orientation
  254. ] readonly def
  255.  
  256. % Define the keys used in output attribute matching.
  257. /.outputattrkeys [
  258.   /OutputType
  259. ] readonly def
  260.  
  261. % Define all the parameters that should always be copied to the merged
  262. % dictionary.
  263. /.copiedkeys [
  264.   /OutputDevice
  265.   .mergespecial { pop } forall
  266.   .inputattrkeys aload pop
  267.   .inputselectionkeys aload pop
  268.   .outputattrkeys aload pop
  269. ] readonly def
  270.  
  271. % Define the parameters that should not be presented to the device.
  272. % The procedures are called as follows:
  273. %    <merged> <key> <value> -proc-
  274. % The procedure leaves all its operands on the stack and returns
  275. % true iff the key/value pair should be presented to .putdeviceparams.
  276. /.presentspecial mark
  277.   .dynamicppkeys { pop false } forall
  278.             % We must ignore an explicit request for .MediaSize,
  279.             % because media matching always handles this.
  280.   /.MediaSize false
  281.   /Name false
  282.   /OutputDevice false
  283.   /PageOffset false
  284.   /PageSize false        % obsolete alias for .MediaSize
  285.   /InputAttributes false
  286.   .inputattrkeys
  287.     { dup /PageSize eq
  288.        { pop }
  289.        { { 2 index /InputAttributes .knownget { null eq } { true } ifelse } }
  290.       ifelse
  291.     }
  292.   forall
  293.   .inputselectionkeys { false } forall
  294.   /OutputAttributes false
  295.   .outputattrkeys
  296.     { { 2 index /OutputAttributes .knownget { null eq } { true } ifelse } }
  297.   forall
  298.   /Install false
  299.   /BeginPage false
  300.   /EndPage false
  301.   /Policies false
  302.     % Our extensions:
  303.   /HWColorMap
  304.     {            % HACK: don't transmit the color map, because
  305.             % window systems can change the color map on their own
  306.             % incrementally.  Someday we'll have a better
  307.             % solution for this....
  308.       false
  309.     }
  310.   /ViewerPreProcess false
  311. .dicttomark readonly def
  312.  
  313. % Define access to device defaults.
  314. /.defaultdeviceparams
  315.  { finddevice null .getdeviceparams
  316.  } bind def
  317.  
  318. % Select media (input or output).  The hard work is done in an operator:
  319. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
  320. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia false
  321. %    <pagedict> null <policydict> <keys> .matchmedia null true
  322. /.selectmedia        % <orig> <request> <merged> <failed>     <-- retained
  323.             %   <attrdict> <policydict> <attrkeys> <mediakey>
  324.             %   .selectmedia
  325.  { 5 index 5 -2 roll 4 index .matchmedia
  326.         % Stack: orig request merged failed attrkeys mediakey
  327.         %   (key true | false)
  328.     { 4 index 3 1 roll put pop
  329.     }
  330.     {    % Adobe's implementations have a "big hairy heuristic"
  331.     % to choose the set of keys to report as having failed the match.
  332.     % For the moment, we report any keys that are in the request
  333.     % and don't have the same value as in the original dictionary.
  334.       5 index 1 index .knownget
  335.        { 4 index 3 1 roll put }
  336.        { 3 index exch .undef }
  337.       ifelse
  338.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  339.      3 index 1 index .knownget
  340.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  341.       { true }
  342.      ifelse        % Stack: ... <failed> <attrkey> <report>
  343.       { 2 copy /rangecheck put }
  344.      if pop
  345.        }
  346.       forall
  347.     }
  348.    ifelse
  349.  } bind def
  350.  
  351. % Apply Policies to any unprocessed failed requests.
  352. % As we process each request entry, we replace the error name
  353. % in the <failed> dictionary with the policy value,
  354. % and we replace the key in the <merged> dictionary with its prior value
  355. % (or remove it if it had no prior value).
  356. /.applypolicies        % <orig> <merged> <failed> .applypolicies
  357.             %   <orig> <merged'> <failed'>
  358.  { 1 index /Policies get 1 index
  359.     { type /integertype eq
  360.        { pop        % already processed
  361.        }
  362.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  363.             % Stack: <orig> <merged> <failed> <Policies> <key>
  364.             %   <policy>
  365.      dup 1 ne
  366.       {    % Set errorinfo and signal a configurationerror.
  367.         % Note that we currently treat all Policy values other than 1
  368.         % the same as 0.
  369.         pop dup 4 index exch get 2 array astore
  370.         $error /errorinfo 3 -1 roll put
  371.         cleartomark
  372.         /setpagedevice load /configurationerror signalerror
  373.       }
  374.       {    % Roll back the failed request to its previous status.
  375. DEBUG { (Rolling back.\n) print pstack flush } if
  376.         3 index 2 index 3 -1 roll put
  377.         4 index 1 index .knownget
  378.          { 4 index 3 1 roll put }
  379.          { 3 index exch .undef }
  380.         ifelse
  381.       }
  382.      ifelse
  383.        }
  384.       ifelse
  385.     }
  386.    forall pop
  387.  } bind def
  388.  
  389. % Prepare to present parameters to the device, by spreading them onto the
  390. % operand stack and removing any that shouldn't be presented.
  391. /.prepareparams        % <params> .prepareparams -mark- <key1> <value1> ...
  392.  { mark exch dup
  393.     {            % Stack: -mark- key1 value1 ... merged key value
  394.       .presentspecial 2 index .knownget
  395.        { exec { 3 -1 roll } { pop pop } ifelse }
  396.        { 3 -1 roll }
  397.       ifelse
  398.     }
  399.    forall pop
  400.  } bind def
  401.  
  402. % Put device parameters without resetting currentpagedevice.
  403. % (.putdeviceparams clears the current page device.)
  404. /.putdeviceparamsonly    % <device> <Policies|null> <require_all> -mark-
  405.             %   <key1> <value1> ... .putdeviceparamsonly
  406.             % On success: <device> <eraseflag>
  407.             % On failure: <device> <Policies|null> <req_all> -mark-
  408.             %   <key1> <error1> ...
  409.  { .currentpagedevice
  410.     { counttomark 4 add 1 roll .putdeviceparams
  411.       dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
  412.       .setpagedevice
  413.     }
  414.     { pop .putdeviceparams
  415.     }
  416.    ifelse
  417.  } bind def
  418.  
  419. % Try setting the device parameters from the merged request.
  420. /.trysetparams        % <merged> <(ignored)> <device> <Policies>
  421.             %   .trysetparams
  422.  { true 4 index .prepareparams
  423.             % Add the computed .MediaSize.
  424.             % Stack: merged (ignored) device Policies -true-
  425.             %   -mark- key1 value1 ...
  426.    counttomark 5 add index .computemediasize
  427.    exch pop exch pop /.MediaSize exch
  428. DEBUG { (Putting.\n) print pstack flush } if
  429.    .putdeviceparamsonly
  430. DEBUG { (Result of putting.\n) print pstack flush } if
  431.  } bind def
  432.  
  433. % Compute the media size and initial matrix from a merged request (after
  434. % media selection).
  435. /.computemediasize    % <request> .computemediasize
  436.             %   <request> <matrix> <[width height]>
  437.  { dup /PageSize get                    % requested page size
  438.    1 index /InputAttributes get
  439.      2 index (%MediaSource) get get /PageSize get    % media size
  440.                             % (may be a range)
  441.    2 index /Policies get
  442.      dup /PageSize .knownget
  443.       { exch pop } { /PolicyNotFound get } ifelse    % PageSize policy,
  444.                             % affects scaling
  445.    3 index /Orientation .knownget not { null } if
  446.    matrix .matchpagesize pop        % (can't fail)
  447.    2 array astore
  448.  } bind def
  449.  
  450. % ---------------- setpagedevice itself ---------------- %
  451.  
  452. /setpagedevice
  453.  { mark exch currentpagedevice
  454.  
  455.         % Check whether we are changing OutputDevice;
  456.         % also handle the case where the current device
  457.         % is not a page device.
  458.         % Stack: mark <request> <current>
  459. DEBUG { (Checking.\n) print pstack flush } if
  460.  
  461.    dup /OutputDevice .knownget
  462.     {        % Current device is a page device.
  463.       2 index /OutputDevice .knownget
  464.        {    % A specific OutputDevice was requested.
  465.      2 copy eq
  466.       { pop pop null }
  467.       { exch pop }
  468.      ifelse
  469.        }
  470.        { pop null
  471.        }
  472.       ifelse
  473.     }
  474.     {        % Current device is not a page device.
  475.         % Use the default device.
  476.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  477.     }
  478.    ifelse
  479.    dup null eq
  480.     { pop
  481.     }
  482.     { exch pop .defaultdeviceparams
  483.         % In case of duplicate keys, .dicttomark takes the entry
  484.         % lower on the stack, so we can just append the defaults here.
  485.       .requiredattrs { } forall .dicttomark
  486.     }
  487.    ifelse
  488.  
  489.         % Check whether a viewer wants to intervene.
  490.         % We must check both the request (which takes precedence)
  491.         % and the current dictionary.
  492.         % Stack: mark <request> <orig>
  493.    exch dup /ViewerPreProcess .knownget
  494.     { exec }
  495.     { 1 index /ViewerPreProcess .knownget { exec } if }
  496.    ifelse exch
  497.  
  498.         % Construct a merged request from the actual request plus
  499.         % any keys that should always be propagated.
  500.         % Stack: mark <request> <orig>
  501. DEBUG { (Merging.\n) print pstack flush } if
  502.  
  503.    exch 1 index length 1 index length add dict
  504.    .copiedkeys
  505.     {        % Stack: <orig> <request> <merged> <key>
  506.       3 index 1 index .knownget { 3 copy put pop } if pop
  507.     }
  508.    forall
  509.         % Stack: <orig> <request> <merged>
  510.    dup 2 index
  511.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  512.       .mergespecial 2 index .knownget { exec } if
  513.       put dup
  514.     }
  515.    forall pop
  516.         % Hack: if FIXEDRESOLUTION is true, discard any attempt to
  517.         % change HWResolution.
  518.    FIXEDRESOLUTION { dup /HWResolution .undef } if
  519.  
  520.         % Select input and output media.
  521.         % Stack: mark <orig> <request> <merged>
  522. DEBUG { (Selecting.\n) print pstack flush } if
  523.  
  524.    0 dict    % <failed>
  525.    1 index /InputAttributes .knownget
  526.     { 2 index /Policies get
  527.       .inputattrkeys (%MediaSource) cvn .selectmedia
  528.     } if
  529.    1 index /OutputAttributes .knownget
  530.     { 2 index /Policies get
  531.       .outputattrkeys (%MediaDestination) cvn .selectmedia
  532.      } if
  533.    3 -1 roll 4 1 roll        % temporarily swap orig & request
  534.    .applypolicies
  535.    3 -1 roll 4 1 roll        % swap back
  536.  
  537.         % Construct the new device, and attempt to set its attributes.
  538.         % Stack: mark <orig> <request> <merged> <failed>
  539. DEBUG { (Constructing.\n) print pstack flush } if
  540.  
  541.    currentdevice .devicename 2 index /OutputDevice get eq
  542.     { currentdevice }
  543.     { 1 index /OutputDevice get finddevice }
  544.    ifelse
  545.         %**************** We should copy the device here,
  546.         %**************** but since we can't close the old device,
  547.         %**************** we don't.  This is WRONG.
  548.     %****************copydevice
  549.    2 index /Policies get
  550.    .trysetparams
  551.    dup type /booleantype ne
  552.     {        % The request failed.
  553.         % Stack: ... <orig> <request> <merged> <failed> <device>
  554.         %   <Policies> true mark <name> <errorname> ...
  555. DEBUG { (Recovering.\n) print pstack flush } if
  556.       counttomark 4 add index
  557.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  558.       pop pop pop
  559.         % Stack: mark ... <orig> <request> <merged> <failed> <device>
  560.         %   <Policies>
  561.       6 2 roll 3 -1 roll 4 1 roll
  562.       .applypolicies
  563.       3 -1 roll 4 1 roll 6 -2 roll
  564.       .trysetparams        % shouldn't fail!
  565.       dup type /booleantype ne
  566.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  567.          /setpagedevice load exch signalerror
  568.        }
  569.       if
  570.     }
  571.    if
  572.  
  573.         % The attempt succeeded.  Install the new device.
  574.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  575. DEBUG { (Installing.\n) print pstack flush } if
  576.  
  577.    pop 2 .endpage
  578.     { 1 true .outputpage
  579.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  580.     }
  581.    if
  582.         % .setdevice clears the current page device!
  583.    .currentpagedevice pop exch
  584.    .setdevice pop
  585.    .setpagedevice
  586.  
  587.         % Merge the request into the current page device.
  588.         % Stack: mark ... <merged> <failed>
  589.    exch currentpagedevice dup length 2 index length add dict
  590.    .copydict .copydict
  591.         % Initialize the default matrix, taking media matching
  592.         % into account.
  593.    .computemediasize pop initmatrix concat
  594.    dup /PageOffset .knownget
  595.     {        % Translate by the given number of 1/72" units in device X/Y.
  596.       dup 0 get exch 1 get
  597.       2 index /HWResolution get dup 1 get exch 0 get
  598.       4 -1 roll mul 72 div   3 1 roll mul 72 div
  599.       idtransform translate
  600.     }
  601.    if
  602.         % We must install the new page device dictionary
  603.         % before calling the Install procedure.
  604.    dup .setpagedevice
  605.    .setdefaultscreen    % Set the default screen before calling Install.
  606.    dup /Install .knownget { exec } if
  607.    matrix currentmatrix .setdefaultmatrix
  608.         % Erase and initialize the page.
  609.    erasepage initgraphics
  610.    .beginpage
  611.  
  612.         % Clean up, calling PolicyReport if needed.
  613.         % Stack: mark ... <failed> <merged>
  614. DEBUG { (Finishing.\n) print pstack flush } if
  615.  
  616.    exch dup length 0 ne
  617.     { 1 index /Policies get /PolicyReport get
  618.       counttomark 1 add 2 roll cleartomark
  619.       exec
  620.     }
  621.     { cleartomark
  622.     }
  623.    ifelse
  624.  
  625.  } odef
  626.  
  627. end                % level2dict
  628. .setlanguagelevel
  629.